home *** CD-ROM | disk | FTP | other *** search
/ The Original Shareware 1.1 / The Original Shareware (WeMake CDs)(Volume 1.1)(CDs, Inc)(1993).iso / 32 / cadence.zip / VOL1NO4.ZIP / TURTLE.LSP < prev   
Text File  |  1986-10-01  |  4KB  |  120 lines
  1. ;      AutoLISP TURTLE_GRAPHICS functions :
  2. ;                                   written by Paul Petersen
  3. ;                                   A B Consulting Co., Inc.
  4. ;                                   3939 N 48th
  5. ;                                   Lincoln NE, 68504
  6. ;
  7. ;                     copyright July 1986
  8. ;
  9. ;
  10. ;  This library of functions implement the turtle graphics language.  The
  11. ;  basic idea of this method is to simulate a turtle holding a pen, placed
  12. ;  on a sheet of paper, that you give commands to.  The commands are
  13. ;  move FORWARD, move BACK, TURN, PENUP, PENDOWN, change PENCOLOR, SETHEADING
  14. ;  to a particular angle, SETPOSITION to a particular location, report the
  15. ;  current turtle position, report the current turtle angle, and initilize
  16. ;  the turtle by placing it in the center heading to the right.
  17. ;  Included with the TURTLE_GRAPHICS library are graphics programs that
  18. ;  have been translated from example programs in BYTE magazine.
  19. ;  The program C:HILBERT was published in BYTE June, 1986 in BASIC
  20. ;
  21.  
  22. (SETQ FILELIST (QUOTE  (FILELIST FORWARD BACK TURN PENUP PENDOWN PENCOLOR
  23.                         SETHEADING SETPOSITION TURTLE_POSITION TURTLE_HEADING
  24.                         INIT_TURTLE DRAWHILBERT C:HILBERT DESIGN WHEEL
  25.                         TRIPIECE PENTPIECE PENTL PENTR TRIPOLYL TRIPOLYR
  26.                         CENTERPIECE C:SPIRA)))
  27.  
  28. (DEFUN FORWARD (DELTA / OFFSET)
  29.         (SETQ OFFSET (STRCAT "@" (RTOS (* 1.0 DELTA) 1 16)
  30.                              "<" (RTOS TURTLE_ANGLE 1 16)))
  31.         (IF  TURTLE_PEN
  32.                 (COMMAND  "LINE" "@" OFFSET "")
  33.                 (COMMAND  "POINT" OFFSET)))
  34.  
  35. (DEFUN BACK (DELTA / OFFSET)
  36.         (SETQ OFFSET (STRCAT "@" (RTOS (* -1.0 DELTA) 1 16)
  37.                              "<" (RTOS TURTLE_ANGLE 1 16)))
  38.         (IF  TURTLE_PEN
  39.                 (COMMAND  "LINE" "@" OFFSET "")
  40.                 (COMMAND  "POINT" OFFSET)))
  41.  
  42. (DEFUN TURN (ANG)
  43.         (SETQ TURTLE_ANGLE (REM (+ TURTLE_ANGLE ANG) 360.0)))
  44.  
  45. (DEFUN PENUP nil
  46.         (SETQ TURTLE_PEN nil))
  47.  
  48. (DEFUN PENDOWN nil
  49.         (SETQ TURTLE_PEN T))
  50.  
  51. (DEFUN PENCOLOR (COLOR / LNAME)
  52.         (COND  ((EQUAL (TYPE COLOR) (QUOTE STR))
  53.                 (SETQ LNAME (STRCAT "TURTLE-" COLOR)))
  54.                 ((EQUAL (TYPE COLOR) (QUOTE INT))
  55.                 (SETQ LNAME (STRCAT "TURTLE-" (ITOA COLOR))))
  56.                 (T  (SETQ LNAME "TURTLE")))
  57.         (IF  (NOT (MEMBER LNAME TURTLE_LAYERS))
  58.                 (PROGN  (SETQ TURTLE_LAYERS (CONS LNAME TURTLE_LAYERS))
  59.                         (COMMAND  "LAYER" "NEW" LNAME "")))
  60.         (COMMAND  "LAYER" "SET" LNAME "COLOR" COLOR LNAME ""))
  61.  
  62. (DEFUN SETHEADING (ANG)
  63.         (SETQ TURTLE_ANGLE (FLOAT ANG)))
  64.  
  65. (DEFUN SETPOSITION (PT)
  66.         (COMMAND  "POINT" PT))
  67.  
  68. (DEFUN TURTLE_POSITION nil
  69.         (GETVAR "LASTPOINT"))
  70.  
  71. (DEFUN TURTLE_HEADING nil
  72.        TURTLE_ANGLE)
  73.  
  74. (DEFUN INIT_TURTLE (YMAX)
  75.         (SETVAR "CMDECHO" 0)
  76.         (SETQ TURTLE_LAYERS nil)
  77.         (COMMAND  "ZOOM" "C" (QUOTE (0 0)) YMAX)
  78.         (COMMAND  "POINT" (QUOTE  (0 0)))
  79.         (SETHEADING 0.0)
  80.         (PENDOWN)
  81.         (PENCOLOR "WHITE"))
  82.  
  83. ;
  84. ; Nth Order Hilbert Curve written for AutoLISP TURTLE GRAPHICS library
  85. ;     adapted from Programming Insight: Hilbert Curves Made Simple
  86. ;     BYTE June 1986
  87. ;
  88.  
  89. (DEFUN DRAWHILBERT nil
  90.         (SETQ ORDER (1- ORDER) SIGN (- SIGN))
  91.         (TURN (* SIGN 90.0))
  92.         (IF  (> ORDER 0)
  93.                 (DRAWHILBERT))
  94.         (FORWARD DIST)
  95.         (SETQ SIGN (- SIGN))
  96.         (TURN (* SIGN 90.0))
  97.         (IF  (> ORDER 0)
  98.                 (DRAWHILBERT))
  99.         (FORWARD DIST)
  100.         (IF  (> ORDER 0)
  101.                 (DRAWHILBERT))
  102.         (TURN (* SIGN 90.0))
  103.         (SETQ SIGN (- SIGN))
  104.         (FORWARD DIST)
  105.         (IF  (> ORDER 0)
  106.                 (DRAWHILBERT))
  107.         (TURN (* SIGN 90.0))
  108.         (SETQ ORDER (1+ ORDER) SIGN (- SIGN)))
  109.  
  110. (DEFUN C:HILBERT (/ TEMP DIST SIGN)
  111.         (SETQ ORDER (GETINT "\nEnter ORDER of Hilbert curve: "))
  112.         (SETQ TEMP (EXPT 2.0 ORDER) CMDSAVE (GETVAR "CMDECHO"))
  113.         (SETVAR "CMDECHO" 0)
  114.         (INIT_TURTLE TEMP)
  115.         (SETQ DIST 1.0 SIGN -1.0)
  116.         (DRAWHILBERT)
  117.         (COMMAND  "ZOOM" "E")
  118.         (SETVAR "CMDECHO" CMDSAVE)
  119.         nil)
  120.